home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
PRUS101.ZIP
/
FDIRBOX.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-12-19
|
27KB
|
1,034 lines
UNIT FDIRBOX;
(***************************************************************************
RELEASE 1.07 - as contained in the file PRUS101.LZH
by Paul Schubert, 2:244/1181.18, GERMANY
--------------------------------------------
organized for Fido's PASCAL related echoes
--------------------------------------------
06/21/1994 to --/--/---- by Paul Schubert, 2:244/1181.18, GERMANY
As far as third party copyrights are not violated this
source code is hereby placed to the public domain. Use
it whatever way you want, but use AT YOUR OWN RISK.
In case you should modify the source rather send your
modifications to the unit's current organizer (see above for
NM address) than to spread it on your own. This will help to
keep the unit updated and grant a certain standard to all
other users as well.
The unit is currently still under work. So it might greatly
benefit of your participation.
Those who contributed to the following piece of source,
listed in alphabethical order:
================================================================
Orazio Czerwenka, Paul Schubert ...
================================================================
YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.
Credits in your own programs are owed to Paul Schubert who
made his former stand alone unit DIRBOX a substantial part
of the PRUSSG project.
***************************************************************************)
{$I FDEFINE.DEF} { Use the general include file for conditional defines and
common compiler directives ... }
{$F+,R-,S-} { ... and afterwards add the unit's specific defines }
INTERFACE
{.$DEFINE USEMOUSE}
{$DEFINE SPDISP} { 2 VERSCHIEDENE DISPLAY METHODEN SIND WÄHLBAR }
USES FCRT { for HIDECURSOR, NORMCURSOR and PUTCHARATR }
,FDOS
{$IFDEF USEMOUSE}
,MAUSI,KBD
{$ENDIF USEMOUSE}
,DOS
;
CONST ANZINCLUDE = 5;
TANONSEL : BYTE = $0F; { TEXTATTRIB non selected }
TASELECT : BYTE = $70; { TEXTATTRIB selected }
TARAND : BYTE = $1E; { border }
TATITEL : BYTE = $5E; { title }
TATAGED : BYTE = $0C; { tagged }
TATAGEDS : BYTE = $74; { tagged and selected }
EXCLUDE : ARRAY[1..ANZINCLUDE] OF STRING[12] = ('','','','','');
INCLUDE : ARRAY[1..ANZINCLUDE] OF STRING[12] = ('','','','','');
SEARCHFOR : STRING[12] = ' ';
DIRMARK : CHAR = #254;
DRIVEMARK : CHAR = #4;
DIRDISPLAYMODE : BYTE = 1;
DRIVESALLOWED : BOOLEAN = TRUE;
DIRSALLOWED : BOOLEAN = TRUE;
EXITKEYS : ARRAY[1..8] OF WORD = (0,0,0,0,0,0,0,0);
EXITKEY : BYTE = 0;
VAR PRINTNAME : PROCEDURE(S:STRING);
FUNCTION SELECTFILE(PTH,NAME:STRING):STRING;
IMPLEMENTATION
CONST WWIDMAX = 4;
WHIGMAX = 23;
WWID : BYTE = 3; { window width }
WHIG : BYTE = 8; { window height }
ANZWID : BYTE = 14;
TYPE STR6 = STRING[6];
STR12 = STRING[12];
STR80 = STRING[80];
DIRPTR = ^DIRREC;
DIRREC = RECORD
NAME : STR12;
ATTR : BYTE;
TIME,SIZE : LONGINT;
NEXT : DIRPTR;
TAG : BOOLEAN;
END;
VAR SCR : POINTER;
WOM,WUM : WORD;
TAALT,XPOS,YPOS : BYTE;
AKTPATH : STR80;
AllDrives : String[26];
{ ------------------------------- }
CONST EXTENDEDKEYS : BOOLEAN = FALSE;
FUNCTION READKEYWORD:WORD;
VAR R : REGISTERS;
BEGIN
IF EXTENDEDKEYS THEN R.AH := $10 ELSE R.AH := 0;
INTR($16,R);
IF NOT EXTENDEDKEYS AND (R.AL = $E0) THEN R.AL := 0;
READKEYWORD := R.AX;
END; { READKEYWORD }
PROCEDURE STUFFKEY(W:WORD); { put WORD into KEYBOARD BUFFER }
VAR R : REGISTERS;
BEGIN
R.AH := 5;
R.CX := W;
INTR($16,R);
END; { STUFFKEY }
{ ------------------------------- }
FUNCTION ATTRTOSTR(ATTR:BYTE):STR6;
VAR ST : STR6;
BEGIN { ATTRTOSTR }
IF (ATTR AND READONLY ) = 0 THEN ST := '-' ELSE ST := 'R';
IF (ATTR AND HIDDEN ) = 0 THEN ST := ST + '-' ELSE ST := ST + 'H';
IF (ATTR AND ARCHIVE ) = 0 THEN ST := ST + '-' ELSE ST := ST + 'A';
IF (ATTR AND SYSFILE ) = 0 THEN ST := ST + '-' ELSE ST := ST + 'S';
IF (ATTR AND DIRECTORY) = 0 THEN ST := ST + '-' ELSE ST := ST + 'D';
IF (ATTR AND VOLUMEID ) = 0 THEN ST := ST + '-' ELSE ST := ST + 'V';
ATTRTOSTR := ST;
END; { ATTRTOSTR }
FUNCTION EXPAND(NAME : STR12):STR12;
VAR A,B : BYTE;
S : STR12;
BEGIN { EXPAND }
A := POS('.',NAME);
IF A > 1 THEN BEGIN
S := '';
FOR B := A TO 8 DO S := S + ' ';
INSERT(S,NAME,A);
END;
EXPAND := NAME;
END; { EXPAND }
PROCEDURE READDIR(PATH:STRING;VAR FILES:WORD;VAR DIRS:WORD;VAR START:DIRPTR);
VAR EINTRAG : SEARCHREC;
NEU : DIRPTR;
I : WORD;
DN : DIRSTR;
FN : NAMESTR;
FE : EXTSTR;
PROCEDURE INSERTLIST(VAR ALT,NEU:DIRPTR);
VAR P : POINTER;
BEGIN
IF ALT = NIL THEN BEGIN
{ sort to end of list }
ALT := NEU;
END ELSE BEGIN
IF ALT^.NAME > NEU^.NAME { name ascending }
THEN BEGIN
{ hook an entry into the list }
P := ALT;
ALT := NEU;
NEU^.NEXT := P;
END ELSE
{ repeat searching }
IF ALT^.NEXT = NIL THEN BEGIN
{ end of list }
ALT^.NEXT := NEU;
END ELSE BEGIN
{ go on recursively }
INSERTLIST(ALT^.NEXT,NEU);
END;
END;
END; { INSERTLIST }
FUNCTION TEST(VAR EINTRAG:SEARCHREC):BOOLEAN;
VAR I : BYTE;
FUNCTION WILL:BOOLEAN;
VAR I : BYTE;
BEGIN
WILL := TRUE;
IF INCLUDE[1] = '' THEN EXIT;
WILL := FALSE;
FOR I := 1 TO ANZINCLUDE DO BEGIN
IF (INCLUDE[I] <> '') AND
(POS(INCLUDE[I],EINTRAG.NAME) <> 0) THEN WILL := TRUE;
END; { NEXT I }
END; { WILL }
BEGIN { TEST }
TEST := FALSE;
WITH EINTRAG DO BEGIN
IF NOT WILL THEN EXIT;
FOR I := 1 TO ANZINCLUDE DO BEGIN
IF (EXCLUDE[I] <> '') AND
(POS(EXCLUDE[I],NAME) <> 0) THEN EXIT;
END; { NEXT I }
TEST := (ATTR AND VOLUMEID) = 0;
END; { WITH EINTRAG }
END; { TEST }
PROCEDURE SPEICHERN;
BEGIN
IF (EINTRAG.ATTR = DIRECTORY) AND (EINTRAG.NAME[1] <> DRIVEMARK) THEN BEGIN
IF LENGTH(EINTRAG.NAME) = 12 THEN DELETE(EINTRAG.NAME,9,1);
IF EINTRAG.NAME = '..' THEN INSERT(' ',EINTRAG.NAME,1)
ELSE INSERT(DIRMARK,EINTRAG.NAME,1);
END;
IF MAXAVAIL < 50 THEN EXIT; {@@@ keep wolves away }
NEW(NEU);
WITH NEU^ DO BEGIN
NAME := EINTRAG.NAME;
ATTR := EINTRAG.ATTR;
TIME := EINTRAG.TIME;
SIZE := EINTRAG.SIZE;
TAG := FALSE;
NEXT := NIL;
END; { WITH }
INSERTLIST(START,NEU);
END; { SPEICHERN }
BEGIN { READDIR }
FILES := 0;
DIRS := 0;
I := LENGTH(PATH);
WHILE (I > 1) AND (PATH[I] <> '\') DO DEC(I);
IF DRIVESALLOWED AND (I <= 3) THEN BEGIN
EINTRAG.NAME := DRIVEMARK+'A:';
FOR I := 1 TO LENGTH(AllDrives) DO BEGIN
IF GETDRIVETYPE(Ord (AllDrives[I]) - Ord('A') + 1) <> dtError THEN BEGIN
EINTRAG.NAME[2] := CHR(I+$40);
EINTRAG.ATTR := DIRECTORY;
EINTRAG.SIZE := -1; { a drive : no size }
EINTRAG.TIME := -1; { a drive : no date }
INC(DIRS);
SPEICHERN;
END;
END; { NEXT I }
END;
IF DIRSALLOWED THEN BEGIN
FSPLIT(PATH,DN,FN,FE);
FINDFIRST(DN+'*.*',DIRECTORY,EINTRAG);
WHILE DOSERROR = 0 DO BEGIN
IF ((EINTRAG.ATTR AND DIRECTORY) > 0) AND
(EINTRAG.NAME <> '.') THEN BEGIN
INC(DIRS);
EINTRAG.SIZE := -1; { don't show size for directories }
SPEICHERN;
END;
FINDNEXT(EINTRAG);
END; { WHILE }
END;
FINDFIRST(PATH,ANYFILE AND NOT DIRECTORY,EINTRAG);
WHILE DOSERROR = 0 DO BEGIN
IF TEST(EINTRAG) THEN BEGIN
INC(FILES);
SPEICHERN;
END;
FINDNEXT(EINTRAG);
END; { WHILE }
END; { READDIR }
PROCEDURE FREEDIR(VAR DP:DIRPTR);
BEGIN { FREEDIR }
IF DP <> NIL THEN BEGIN
FREEDIR(DP^.NEXT);
DISPOSE(DP);
DP := NIL;
END;
END; { FREEDIR }
{3.12.94}
PROCEDURE GETANZWID;
BEGIN
CASE DIRDISPLAYMODE OF
2 : ANZWID := 23; { name, size }
3 : ANZWID := 38; { name, size, date }
4 : ANZWID := 45; { name, size, attributes, date }
ELSE
ANZWID := 14; { name only }
END; { CASE DIRDISPLAYMODE }
END; { GETANZWID }
FUNCTION SELECTDIRREC(START:DIRPTR;MAXANZ:WORD):DIRPTR;
TYPE S2 = STRING[2];
VAR SPALTE : BYTE;
I,PO,ZEILE,MAXAUS,
AUSSCHN,NTAGS : WORD;
ANZAHL : INTEGER;
DX,DY,DXA,DYA : INTEGER;
ENDE : BOOLEAN;
CH2,CH1 : CHAR;
MKB : WORD ABSOLUTE CH1;
ST,SR : STRING[14];
P : DIRPTR;
POINTERLIST : ARRAY[0..WWIDMAX,1..WHIGMAX] OF DIRPTR;
LABEL CALCULATE_WINDOW;
FUNCTION ZS2(NR:INTEGER):S2;
VAR S : S2;
BEGIN
STR(NR:2,S);
IF S[1] = ' ' THEN S[1] := '0';
ZS2 := S;
END; { ZS2 }
PROCEDURE ZEIGNAME(P:DIRPTR);
VAR DT : DATETIME;
TAM : BYTE;
BEGIN
TAM := TEXTATTR;
IF P^.TAG THEN BEGIN
IF TEXTATTR = TASELECT THEN TEXTATTR := TATAGEDS
ELSE TEXTATTR := TATAGED
END;
WITH P^ DO BEGIN
{@@@}
IF (ATTR AND DIRECTORY) = DIRECTORY
THEN ST := ' '+NAME+'\'
ELSE ST := ' '+EXPAND(NAME);
WRITE(ST,'':14-LENGTH(ST));
IF DIRDISPLAYMODE >= 2 THEN BEGIN
IF SIZE <> -1 THEN WRITE(SIZE:8)
ELSE WRITE(' ');
END;
IF (DIRDISPLAYMODE = 4) AND (P^.NAME[1] <> DRIVEMARK) THEN BEGIN
WRITE(' '+ATTRTOSTR(ATTR));
END;
IF DIRDISPLAYMODE >= 3 THEN BEGIN
IF (TIME <> 0) AND (TIME <> -1) THEN BEGIN
UNPACKTIME(TIME,DT);
WITH DT DO
WRITE(' ',DAY:2,'.'+ZS2(MONTH)+'.'+ZS2(YEAR MOD 100)+
' '+ZS2(HOUR)+':'+ZS2(MIN));
END;
END;
IF DIRDISPLAYMODE <> 1 THEN WRITE(' ');
END; { WITH P^ }
TEXTATTR := TAM;
END; { ZEIGNAME }
PROCEDURE BILDAUFBAU;
VAR S,Z : WORD;
{$IFDEF SPDISP}
I : WORD;
{$ENDIF SPDISP}
BEGIN
FILLCHAR(POINTERLIST,SIZEOF(POINTERLIST),0);
P := START;
FOR S := 1 TO AUSSCHN * SUCC(WWID) DO P := P^.NEXT;
TEXTATTR := TANONSEL;
S := 0; Z := 1;
{$IFDEF SPDISP}
(*
CLRSCR;
*)
FOR I := 1 TO AUSSCHN * WHIG DO P := P^.NEXT;
(*
WHILE ( (P <> NIL) AND (S <= WWID) ) DO BEGIN
*)
WHILE S <= WWID DO BEGIN
GOTOXY(2+S*ANZWID,Z);
IF P <> NIL THEN BEGIN
POINTERLIST[S,Z] := P;
ZEIGNAME(P);
P := P^.NEXT;
END ELSE CLREOL;
INC(Z);
IF Z > WHIG THEN BEGIN
Z := 1;
INC(S);
END;
END; { WHILE }
{$ELSE}
WHILE ( (P <> NIL) AND (Z <= WHIG) ) DO BEGIN
GOTOXY(2+S*ANZWID,Z);
POINTERLIST[S,Z] := P;
ZEIGNAME(P);
P := P^.NEXT;
INC(S);
IF S > WWID THEN BEGIN
S := 0;
INC(Z);
CLREOL;
END;
END; { WHILE }
CLREOS;
{$ENDIF ELSEIF SPDISP}
END; { BILDAUFBAU }
PROCEDURE RECHTS; FORWARD;
PROCEDURE LINKS; FORWARD;
PROCEDURE AUFWAERTS;
BEGIN
IF ZEILE > 1 THEN DEC(ZEILE)
ELSE BEGIN
{$IFDEF SPDISP}
IF (SPALTE+AUSSCHN) > 0 THEN BEGIN
ZEILE := WHIG;
LINKS;
WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(ZEILE);
END;
{$ELSE}
IF AUSSCHN > 0 THEN BEGIN
DEC(AUSSCHN);
BILDAUFBAU;
END;
{$ENDIF ELSEIF SPDISP}
END;
END; { AUFWAERTS }
PROCEDURE ABWAERTS;
BEGIN
IF ZEILE < WHIG THEN BEGIN
IF (POINTERLIST[SPALTE,SUCC(ZEILE)] <> NIL) THEN INC(ZEILE);
END ELSE BEGIN
{$IFDEF SPDISP}
ZEILE := 1;
RECHTS;
{$ELSE}
IF AUSSCHN < MAXAUS THEN BEGIN
INC(AUSSCHN);
BILDAUFBAU;
END;
WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(SPALTE);
{$ENDIF ELSEIF SPDISP}
END;
END; { ABWAERTS }
PROCEDURE RECHTS;
BEGIN
IF SPALTE < WWID THEN BEGIN
IF POINTERLIST[SUCC(SPALTE),ZEILE] <> NIL THEN INC(SPALTE);
END ELSE BEGIN
{$IFDEF SPDISP}
IF AUSSCHN < MAXAUS THEN BEGIN
INC(AUSSCHN);
BILDAUFBAU;
END;
WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(ZEILE);
{$ELSE}
SPALTE := 0;
ABWAERTS;
{$ENDIF ELSEIF SPDISP}
END;
END; { RECHTS }
PROCEDURE LINKS;
BEGIN
IF SPALTE > 0 THEN DEC(SPALTE) ELSE BEGIN
{$IFDEF SPDISP}
IF AUSSCHN > 0 THEN BEGIN
DEC(AUSSCHN);
BILDAUFBAU;
END;
{$ELSE}
IF (ZEILE + AUSSCHN) > 1 THEN BEGIN
AUFWAERTS;
SPALTE := WWID;
END;
{$ENDIF ELSEIF SPDISP}
END;
END; { LINKS }
PROCEDURE CURSHOME;
BEGIN
ZEILE := 1;
SPALTE := 0;
IF AUSSCHN > 0 THEN BEGIN
AUSSCHN := 0;
BILDAUFBAU;
END;
END; { CURSHOME }
PROCEDURE CURSEND;
BEGIN
IF AUSSCHN < MAXAUS THEN BEGIN
AUSSCHN := MAXAUS;
BILDAUFBAU;
END;
{$IFDEF SPDISP}
ZEILE := 1;
SPALTE := WWID;
WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(SPALTE);
ZEILE := WHIG;
WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(ZEILE);
{$ELSE}
ZEILE := WHIG;
SPALTE := 0;
WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(ZEILE);
SPALTE := WWID;
WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(SPALTE);
{$ENDIF ELSEIF SPDISP}
END; { CURSEND }
PROCEDURE SETCURSOR(PO:WORD);
BEGIN
{$IFDEF SPDISP}
SPALTE := PO DIV WHIG ;
ZEILE := SUCC(PO MOD WHIG);
WHILE SPALTE > WWID DO BEGIN
DEC(SPALTE);
INC(AUSSCHN);
END;
{$ELSE}
ZEILE := SUCC(PO DIV SUCC(WWID));
SPALTE := PO MOD SUCC(WWID);
WHILE ZEILE >= WHIG DO BEGIN
DEC(ZEILE);
INC(AUSSCHN);
END;
{$ENDIF ELSEIF SPDISP}
END; { SETCURSOR }
FUNCTION SUCHE:BOOLEAN;
VAR P,FP : DIRPTR;
BEGIN
PO := 0;
P := START;
WHILE P^.NEXT <> NIL DO BEGIN
(* search for filename stored in SR *)
IF P^.NAME < SR THEN BEGIN
INC(PO);
FP := P^.NEXT;
END;
P := P^.NEXT;
END; { WHILE }
SUCHE := ( COPY(FP^.NAME,1,LENGTH(SR)) = SR );
ZEILE := SUCC(PO DIV SUCC(WWID));
AUSSCHN := 0;
SETCURSOR(PO);
BILDAUFBAU;
END; { SUCHE }
PROCEDURE ZEIGESR;
VAR TA : BYTE;
BEGIN
{3.12.94}
IF (LO(WINDMAX)-LO(WINDMIN)) <= 20 THEN EXIT;
TA := TEXTATTR;
TEXTATTR := TARAND;
WINDOW(LO(WOM) + 2,HI(WOM)+2,LO(WUM),HI(WUM)+1);
GOTOXY(2,SUCC(HI(WINDMAX)-HI(WINDMIN)));
IF SR = '' THEN WRITE('════════════════════')
ELSE WRITE(' '+SR+' ═');
WINDOW(LO(WOM) + 2,HI(WOM)+3,LO(WUM),HI(WUM));
TEXTATTR := TA;
END; { ZEIGESR }
PROCEDURE ALLTAGS(WAS:BOOLEAN);
VAR P : DIRPTR;
BEGIN
NTAGS := 0;
P := START;
REPEAT
IF (P^.ATTR AND (VOLUMEID OR DIRECTORY)) = 0 THEN BEGIN
P^.TAG := WAS;
IF WAS THEN INC(NTAGS);
END;
P := P^.NEXT;
UNTIL P = NIL;
BILDAUFBAU;
END; { ALLTAGS }
BEGIN { SELECTDIRREC }
EXITKEY := 0;
SELECTDIRREC := NIL;
IF START = NIL THEN EXIT;
SR := '';
WINDOW(LO(WOM) + 2,HI(WOM)+3,LO(WUM),HI(WUM));
CALCULATE_WINDOW:
{3.12.94}
GETANZWID;
IF ANZWID >= (LO(WINDMAX) - LO(WINDMIN)) THEN BEGIN
INC(DIRDISPLAYMODE);
IF DIRDISPLAYMODE > 4 THEN DIRDISPLAYMODE := 1;
GOTO CALCULATE_WINDOW;
END;
ZEILE := 1; SPALTE := 0; AUSSCHN := 0;
{3.12.94}
WWID := PRED( PRED(LO(WINDMAX) - LO(WINDMIN) ) DIV ANZWID);
PO := 0;
P := START; ANZAHL := 1;
WHILE P^.NEXT <> NIL DO BEGIN
(* search for filename stored in SEARCHFOR *)
IF P^.NAME <= SEARCHFOR THEN PO := PRED(ANZAHL);
INC(ANZAHL);
P := P^.NEXT;
END; { WHILE }
IF P^.NAME <= SEARCHFOR THEN PO := PRED(ANZAHL);
SETCURSOR(PO);
ANZAHL := ANZAHL - (SUCC(WWID) * WHIG);
IF ANZAHL < 1 THEN MAXAUS := 0 ELSE BEGIN
{$IFDEF SPDISP}
MAXAUS := ANZAHL DIV WHIG;
IF ANZAHL MOD WHIG > 0 THEN INC(MAXAUS);
{$ELSE}
MAXAUS := ANZAHL DIV SUCC(WWID);
IF ANZAHL MOD SUCC(WWID) > 0 THEN INC(MAXAUS);
{$ENDIF ELSEIF SPDISP}
END;
BILDAUFBAU;
ENDE := FALSE;
DX := 0;
DY := 0;
NTAGS := 0;
REPEAT
TEXTATTR := TASELECT;
IF ZEILE = 0 THEN INC(ZEILE); { 3.12.94 WARUM DENN NUR ???? }
GOTOXY(2+SPALTE*ANZWID,ZEILE);
ZEIGNAME(POINTERLIST[SPALTE,ZEILE]);
{$IFDEF USEMOUSE}
REPEAT
GETMICKEYCOUNT(DXA,DYA);
DX := DX + DXA;
DY := DY + DYA;
IF ABS(DY) > 6 THEN BEGIN
IF DY < 0 THEN BEGIN
STUFFKEY(72 SHL 8);
END ELSE BEGIN
STUFFKEY(80 SHL 8);
END;
DY := 0;
END;
IF ABS(DX) > 32 THEN BEGIN
IF DX < 0 THEN BEGIN
STUFFKEY(75 SHL 8);
END ELSE BEGIN
STUFFKEY(77 SHL 8);
END;
DX := 0;
END;
UNTIL KEYPRESSED OR MOUSEPRESSED;
MKB := READKEYORBUTTON;
IF LO(MKB) = $E0 THEN BEGIN
{ delete 'E0' for normal keyboard driver }
MKB := MKB AND $FF00;
END;
IF MKB = MOUSELFT THEN MKB := 13; { left mousekey = <Ret> }
IF MKB = MOUSERT THEN MKB := 27; { right mousekey = <Esc> }
{$ELSE}
MKB := READKEYWORD;
{$ENDIF USEMOUSE}
FOR I := 1 TO 8 DO IF MKB = EXITKEYS[I] THEN BEGIN
EXITKEY := I;
MKB := 13{27};
END;
CASE CH1 OF
^I : BEGIN
INC(DIRDISPLAYMODE);
IF DIRDISPLAYMODE > 4 THEN DIRDISPLAYMODE := 1;
GOTO CALCULATE_WINDOW;
END;
^[ : BEGIN { ESC }
SELECTDIRREC := NIL;
ENDE := TRUE;
END;
^T : ALLTAGS(TRUE);
^U : ALLTAGS(FALSE);
^M : BEGIN { ENTER }
SELECTDIRREC := POINTERLIST[SPALTE,ZEILE];
ENDE := TRUE;
END;
#8 : BEGIN
SR := '';
ZEIGESR;
END;
' ' : WITH POINTERLIST[SPALTE,ZEILE]^ DO BEGIN
IF (ATTR AND (VOLUMEID OR DIRECTORY)) = 0 THEN BEGIN
TAG := NOT TAG;
IF TAG THEN INC(NTAGS)
ELSE DEC(NTAGS);
STUFFKEY(77 SHL 8);
END;
SR := '';
ZEIGESR;
END;
#1..#31 : BEGIN END;
#0 : BEGIN { function keys }
IF (CH2 <> #73) AND (CH2 <> #81) THEN BEGIN
GOTOXY(2+SPALTE*ANZWID,ZEILE);
TEXTATTR := TANONSEL;
ZEIGNAME(POINTERLIST[SPALTE,ZEILE]);
END;
END;
ELSE
SR := SR + UPCASE(CH1);
IF NOT SUCHE THEN SR := '';
ZEIGESR;
END; { CASE CH1 }
CASE CH2 OF
#72 : BEGIN { UP }
SR := '';
AUFWAERTS;
ZEIGESR;
END;
#80 : BEGIN { DOWN }
SR := '';
ABWAERTS;
ZEIGESR;
END;
#75 : BEGIN { LEFT }
SR := '';
LINKS;
ZEIGESR;
END;
#77 : BEGIN { RIGHT }
SR := '';
RECHTS;
ZEIGESR;
END;
#73 : BEGIN { PG UP }
SR := '';
IF AUSSCHN > 0 THEN BEGIN
{$IFDEF SPDISP}
IF AUSSCHN > PRED(WWID) THEN DEC(AUSSCHN,WWID)
ELSE AUSSCHN := 0;
{$ELSE}
IF AUSSCHN > PRED(WHIG) THEN DEC(AUSSCHN,PRED(WHIG))
ELSE AUSSCHN := 0;
{$ENDIF ELSEIF SPDISP}
END ELSE CURSHOME;
BILDAUFBAU;
ZEIGESR;
END;
#81 : BEGIN { PG DOWN }
SR := '';
IF AUSSCHN < MAXAUS THEN BEGIN
{$IFDEF SPDISP}
INC(AUSSCHN,WWID);
IF AUSSCHN > MAXAUS THEN AUSSCHN := MAXAUS;
WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(ZEILE);
{$ELSE}
INC(AUSSCHN,PRED(WHIG));
IF AUSSCHN > MAXAUS THEN AUSSCHN := MAXAUS;
WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(SPALTE);
{$ENDIF ELSEIF SPDISP}
END ELSE CURSEND;
BILDAUFBAU;
ZEIGESR;
END;
#71 : BEGIN { HOME }
SR := '';
CURSHOME;
ZEIGESR;
END;
#79 : BEGIN { END }
SR := '';
CURSEND;
ZEIGESR;
END;
END; { CASE CH2 }
UNTIL ENDE;
IF NTAGS > 0 THEN BEGIN
P := START;
REPEAT
{$V-}
IF P^.TAG THEN PRINTNAME(AKTPATH+P^.NAME);
{$V+}
P := P^.NEXT;
UNTIL P = NIL;
END;
WINDOW(LO(WOM) + 2,HI(WOM)+2,LO(WUM),HI(WUM));
END; { SELECTDIRREC }
PROCEDURE SAVEWINDOW;
VAR I : INTEGER;
PROCEDURE LINIE;
VAR WID : BYTE;
BEGIN
WID := PRED(LO(WINDMAX) - LO(WINDMIN));
PUTCHARATTR('═',TEXTATTR,WID);
GOTOXY(WHEREX+WID,WHEREY);
END;
BEGIN
WHIG := PRED( (HI(WINDMAX) - HI(WINDMIN) - 1) );
WOM := WINDMIN;
WUM := WINDMAX;
TAALT := TEXTATTR;
XPOS := WHEREX;
YPOS := WHEREY;
PUSHWINDOW;
TEXTATTR := TARAND;
GOTOXY(1,1);
WRITE('╔');
LINIE;
WRITE('╗');
FOR I := 2 TO (HI(WINDMAX) - HI(WINDMIN)) DO BEGIN
GOTOXY(1,I); WRITE('║');
GOTOXY(SUCC(LO(WINDMAX)-LO(WINDMIN)),I); WRITE('║');
END;
WRITE('╚');
LINIE;
PUTCHARATTR('╝',TEXTATTR,1);
WINDOW(LO(WOM)+2,HI(WOM)+2,LO(WUM),HI(WUM));
END; { SAVEWINDOW }
PROCEDURE RESTOREWINDOW;
BEGIN
POPWINDOW;
WINDOW(SUCC(LO(WOM)),SUCC(HI(WOM)),SUCC(LO(WUM)),SUCC(HI(WUM)));
GOTOXY(XPOS,YPOS);
TEXTATTR := TAALT;
END; { RESTOREWINDOW }
FUNCTION SELECTFILE(PTH,NAME:STRING):STRING;
VAR EXECOM,FILEPTR : DIRPTR;
SP,I,WINDW : BYTE;
NFILES,NDIRS : WORD;
PATH,PM : STRING;
S1 : STRING[80];
NS : STRING[10];
DIRECTORY : BOOLEAN;
SR : SEARCHREC;
LABEL ENDE;
BEGIN { SELECTFILE }
SELECTFILE := '';
{3.12.94}
GETANZWID;
WHILE (ANZWID+3) > (LO(WINDMAX) - LO(WINDMIN)) DO BEGIN
IF LO(WINDMAX) < 78 THEN BEGIN
INC(WINDMAX);
END ELSE BEGIN
IF LO(WINDMIN) > 1 THEN DEC(WINDMIN);
END;
END;
WHILE (HI(WINDMAX) - HI(WINDMIN)) < 3 DO BEGIN
IF HI(WINDMAX) < 25 THEN BEGIN
INC(WINDMAX,$100);
END ELSE BEGIN
IF HI(WINDMIN) > 1 THEN DEC(WINDMIN,$100);
END;
END;
SAVEWINDOW;
EXECOM := NIL;
IF PTH = '' THEN GETDIR(0,PATH) ELSE PATH := PTH;
REPEAT
IF PATH[LENGTH(PATH)] <> '\' THEN PATH := PATH + '\';
FREEDIR(EXECOM);
TEXTATTR := TANONSEL;
CLRSCR;
TEXTATTR := $4E;
WRITE(' warten ');
READDIR(PATH+NAME,NFILES,NDIRS,EXECOM);
HIDECURSOR;
STR(NFILES,NS);
AKTPATH := PATH;
WINDW := LO(WINDMAX) - LO(WINDMIN) - 2;
IF (POS('.*',NAME) > 0) AND (INCLUDE[1] <> '') THEN BEGIN
S1 := ' '+PATH+'*';
I := 1;
WHILE (I <= ANZINCLUDE) AND ( (LENGTH(S1)+5) < WINDW ) DO BEGIN
IF (I > 1) AND (INCLUDE[I] <> '') THEN S1 := S1 + ',';
S1 := S1 + INCLUDE[I];
INC(I);
END;
IF I <= ANZINCLUDE THEN S1 := S1+'..';
END ELSE BEGIN
S1 := ' '+PATH+NAME;
END;
{ 18.12.94 }
IF LENGTH(S1) > WINDW THEN BEGIN
SP := LENGTH(S1);
WHILE (SP > 0) AND (S1[SP] <> '\') DO DEC(SP);
IF SP > 1 THEN DEC(SP);
WHILE (SP > 0) AND (S1[SP] <> '\') DO DEC(SP);
IF SP > 4 THEN BEGIN
DELETE(S1,4,SP-4);
INSERT('..',S1,4);
END;
END;
IF (LENGTH(S1)+LENGTH(NS)+7) < WINDW THEN S1 := S1 + +' '+NS+' Files ';
{ 3.12.94 }
IF LENGTH(S1) > WINDW THEN S1 := NAME;
TEXTATTR := TANONSEL; GOTOXY(1,1); CLREOL;
GOTOXY((LO(WINDMAX)-LO(WINDMIN)-LENGTH(S1)+2) SHR 1,1);
TEXTATTR := TATITEL; WRITE(S1);
FILEPTR := SELECTDIRREC(EXECOM,NFILES+NDIRS);
NORMCURSOR;
PM := PATH;
IF FILEPTR = NIL THEN BEGIN
IF (NFILES + NDIRS) = 0 THEN BEGIN
TEXTATTR := TANONSEL;
WRITELN(#7);
CASE DOSERROR OF
(*
3 : WRITELN(' Pfad nicht gefunden');
18 : WRITELN(' keine Dateien gefunden');
ELSE
WRITELN('ungültiges Laufwerk');
END;
WRITELN(' Taste drücken');
*)
3 : WRITELN(' Path not found');
18 : WRITELN(' no files found');
ELSE
WRITELN('not a valid drive');
END;
WRITELN(' press any key');
{$IFDEF USEMOUSE}
IF READKEYORBUTTON = 0 THEN;
{$ELSE USEMOUSE}
IF READKEYWORD = 0 THEN;
{$ENDIF USEMOUSE}
END;
{ <ESC> = cancel }
GOTO ENDE;
END;
IF EXITKEY = 0 THEN BEGIN
DIRECTORY := (FILEPTR^.ATTR AND DOS.DIRECTORY) <> 0;
{ NAME[1] = DRIVEMARK is a name of a drive }
IF FILEPTR^.NAME[1] = DRIVEMARK THEN BEGIN
PATH := COPY(FILEPTR^.NAME,2,PRED(LENGTH(FILEPTR^.NAME))) + '\';
FINDFIRST(PATH+'*.*',ANYFILE,SR);
IF NOT (DOSERROR IN [0,18]) THEN BEGIN
WRITE(#7);
PATH := PM;
END;
END ELSE BEGIN
{ DIRECTORIES are marked as NAME[1] = DIRMARK }
IF (FILEPTR^.NAME[1] = DIRMARK) OR
(FILEPTR^.NAME = ' ..')
THEN BEGIN
DELETE(FILEPTR^.NAME,1,1);
IF (LENGTH(FILEPTR^.NAME) > 8) AND
(POS('.',FILEPTR^.NAME) = 0) THEN INSERT('.',FILEPTR^.NAME,9);
END;
PATH := PATH + FILEPTR^.NAME;
IF (FILEPTR^.NAME = '..') THEN BEGIN
SP := LENGTH(PATH) - 3;
PATH := COPY(PATH,1,SP);
WHILE PATH[SP] <> '\' DO DEC(SP);
PATH := COPY(PATH,1,PRED(SP));
END;
END;
END ELSE BEGIN
SEARCHFOR := FILEPTR^.NAME;
IF (FILEPTR^.NAME[1] = DIRMARK) OR (FILEPTR^.NAME[1] = DRIVEMARK) THEN BEGIN
SELECTFILE := PATH;
END ELSE BEGIN
SELECTFILE := PATH + FILEPTR^.NAME;
END;
GOTO ENDE;
END; { IF EXITKEY = 0 }
UNTIL (NOT DIRECTORY) OR (EXITKEY <> 0);
SEARCHFOR := FILEPTR^.NAME;
SELECTFILE := PATH;
ENDE:
RESTOREWINDOW;
FREEDIR(EXECOM);
END; { SELECTFILE }
PROCEDURE DUMMY(S:STRING);
BEGIN
END; { DUMMY }
BEGIN
PRINTNAME := DUMMY;
AllDrives := LogiCalDrives;
END.